home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / applic / NCSA_Telnet / PC / msdos / contributions / SUBTEK.FOR.BL < prev    next >
Encoding:
Text File  |  1990-11-15  |  41.0 KB  |  1,379 lines
  1. C
  2. C----------SUBROUTINE--INITT-------------------------TEKTRONIX, INC.----
  3. C
  4.       SUBROUTINE INITT(IBAUD)
  5.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  6.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  7.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  8.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  9.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  10.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  11.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  12.      & KINLFT,KOTLFT,KUNIT
  13.  
  14. C
  15. C     THE FOLLOWING LINES ARE ADDED FOR THE VAX 11-750
  16. C     FOR TERMINAL DEFINITION
  17. C
  18.       CALL CHANNEL
  19. C
  20. C     END OF ADDITION
  21. C
  22.       KBAUDR=IBAUD
  23.       KPAD2=KBAUDR/308+1
  24.       KGNMOD=0
  25.       KPADV=0
  26.       KOBLEN=89
  27.       KTERM=1
  28.       KFACTR=4
  29. C * SET THE OUTPUT BUFFER FORMAT
  30.       CALL SETBUF(3)
  31.       KINLFT=0
  32.       KOTLFT=1
  33.       CALL RESET
  34.       CALL NEWPAG
  35.       RETURN
  36.       END
  37. c
  38. C
  39. C----------SUBROUTINE--TWINDO------------------------TEKTRONIX, INC.----
  40. C
  41.       SUBROUTINE TWINDO(MINX,MAXX,MINY,MAXY)
  42.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  43.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  44.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  45.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  46.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  47.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  48.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  49.      & KINLFT,KOTLFT,KUNIT
  50. C * DEFINE TERMINAL WINDOW IN TERMINAL COMMON AREA
  51.       KMINSX=MINX
  52.       KMAXSX=MAXX
  53.       KMINSY=MINY
  54.       KMAXSY=MAXY
  55.       CALL RESCAL
  56.       RETURN
  57.       END
  58. c
  59. C
  60. C----------SUBROUTINE--DWINDO------------------------TEKTRONIX, INC.----
  61. C
  62.       SUBROUTINE DWINDO(XMIN,XMAX,YMIN,YMAX)
  63.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  64.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  65.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  66.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  67.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  68.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  69.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  70.      & KINLFT,KOTLFT,KUNIT
  71. C * DEFINE DATA WINDOW IN TERMINAL COMMON AREA
  72.       TMINVX=XMIN
  73.       TMAXVX=XMAX
  74.       TMINVY=YMIN
  75.       TMAXVY=YMAX
  76.       CALL RESCAL
  77.       RETURN
  78.       END
  79. c
  80. C
  81. C----------SUBROUTINE--POINTA------------------------TEKTRONIX, INC.----
  82. C
  83.       SUBROUTINE POINTA(X,Y)
  84.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  85.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  86.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  87.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  88.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  89.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  90.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  91.      & KINLFT,KOTLFT,KUNIT
  92.       CALL LVLCHT
  93. C * CONVERT TO SCREEN CO-ORDINATES
  94.       CALL V2ST(0,X,Y,IX,IY)
  95. C * SKIP IF LINE COMPLETELY OUTSIDE WINDOW
  96.       IF(KGNFLG .EQ. 1)GO TO 10
  97.       IF(KKMODE .NE. 2)CALL PNTMOD
  98.       CALL TKPNT(IX,IY)
  99. 10    RETURN
  100.       END
  101. c
  102. C
  103. C----------SUBROUTINE--DRAWA-------------------------TEKTRONIX, INC.----
  104. C
  105.       SUBROUTINE DRAWA(X,Y)
  106.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  107.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  108.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  109.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  110.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  111.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  112.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  113.      & KINLFT,KOTLFT,KUNIT
  114. C * SET TERMINAL TO DRAW SOLID LINES IF NEEDED
  115. C * THIS SECTION IS NEEDED FOR 4014 ENHANCED ***************************
  116. C      IF(KLINE .EQ. 0)GO TO 5
  117. C      KLINE=0
  118. C      CALL CWSEND
  119. C5     CONTINUE
  120. C **********************************************************************
  121.       CALL LVLCHT
  122. C * CONVERT TO SCREEN CO-ORDINATES
  123.       CALL V2ST(1,X,Y,IX,IY)
  124. C * SKIP IF LINE COMPLETELY OUTSIDE WINDOW
  125.       IF(KGNFLG .EQ. 1)GO TO 10
  126.       IF(KKMODE.NE.1)CALL VECMOD
  127.       IF(KMOVEF.EQ.1)CALL XYCNVT(KBEAMX,KBEAMY)
  128.       CALL XYCNVT(IX,IY)
  129. 10    RETURN
  130.       END
  131. c
  132. C
  133. C----------SUBROUTINE--SCURSR------------------------TEKTRONIX, INC.----
  134. C
  135.       SUBROUTINE SCURSR(ICHAR,IX,IY)
  136.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  137.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  138.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  139.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  140.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  141.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  142.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  143.      & KINLFT,KOTLFT,KUNIT
  144.       DIMENSION ICODE(2),IN(5)
  145.       DATA ICODE(1),ICODE(2)/27,26/
  146. C * SET THE GRAPHIC INPUT FLAG
  147.       KGNMOD=1
  148. C * OUTPUT (ESC) (SUB) TO TURN ON CURSOR
  149.       IF(KTERM .GT. 0)CALL TOUTST(2,ICODE)
  150. C * CURSER SHOULD ALWAYS INPUT A NEW BUFFER
  151.       KINLFT=0
  152.       CALL TINSTR(5,IN)
  153. C * REMOVE THE GRAPHIC INPUT FLAG
  154.       KGNMOD=0
  155. C * RESTORE THE TERMINAL STATUS
  156.       CALL RECOVR
  157.       ICHAR=IN(1)
  158. C * DECODE SCREEN CO-ORDINATES
  159.       IX=MOD(IN(2),32)*32+MOD(IN(3),32)
  160.       IY=MOD(IN(4),32)*32+MOD(IN(5),32)
  161. C * APPLY SCREEN SCALE FACTOR
  162.       IX=IX*4/KFACTR
  163.       IY=IY*4/KFACTR
  164.       RETURN
  165.       END
  166. c
  167. C
  168. C----------SUBROUTINE--ERASE-------------------------TEKTRONIX, INC.----
  169. C
  170.       SUBROUTINE ERASE
  171.       DIMENSION ICODE(2)
  172.       DATA ICODE(1),ICODE(2)/27,12/
  173.       CALL TOUTST(2,ICODE)
  174.       CALL IOWAIT(10)
  175.       CALL RECOVR
  176.       RETURN
  177.       END
  178. c
  179. C
  180. C----------SUBROUTINE--FINITT------------------------TEKTRONIX, INC.----
  181. C
  182.       SUBROUTINE FINITT(IX,IY)
  183.       CALL MOVABS(IX,IY)
  184.       CALL ALFMOD
  185.       CALL TSEND
  186. C     STOP
  187.       RETURN
  188.       END
  189. c
  190. C
  191. C----------SUBROUTINE--MOVABS------------------------TEKTRONIX, INC.----
  192. C
  193.       SUBROUTINE MOVABS(IX,IY)
  194.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  195.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  196.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  197.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  198.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  199.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  200.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  201.      & KINLFT,KOTLFT,KUNIT
  202.       CALL VECMOD
  203.       CALL XYCNVT(IX,IY)
  204.       KGRAFL=0
  205.       RETURN
  206.       END
  207. c
  208. C
  209. C----------SUBROUTINE--SETBUF------------------------TEKTRONIX, INC.----
  210. C
  211.       SUBROUTINE SETBUF(KFORM)
  212.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  213.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  214.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  215.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  216.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  217.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  218.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  219.      & KINLFT,KOTLFT,KUNIT
  220.       KUNIT=KFORM
  221. C * CHECK FOR OUT OF BOUNDS FORMAT TYPES
  222.       IF(KUNIT .LT. 1)KUNIT=1
  223.       IF(KUNIT .GT. 4)KUNIT=4
  224. C * SET MAXIMUM OUTPT CHAR COUNT DEPENDING ON BUFFER TYPE
  225.       IF(KUNIT .GE. 3) GO TO 1
  226.       KACHAR=KOBLEN-11-KPAD2
  227.       KTRAIL=1
  228.       RETURN
  229. 1     KACHAR=KOBLEN
  230.       KTRAIL=0
  231.       RETURN
  232.       END
  233. c
  234.     SUBROUTINE ERRMSG(IERR)
  235. C
  236.     INTEGER*4 LLEN
  237.     INTEGER*4 SYS$GETMSG
  238.     CHARACTER*100 BUFFER
  239. C
  240.     I = SYS$GETMSG(%VAL(IERR),LLEN,BUFFER,%VAL(15),)
  241.     WRITE(6,*) BUFFER(1:LLEN)
  242.     RETURN
  243.     END
  244. C
  245. C----------SUBROUTINE--REVCOT------------------------TEKTRONIX, INC.----
  246. C
  247.       SUBROUTINE REVCOT(IX,IY,X,Y)
  248.       LOGICAL DEC
  249.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  250.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  251.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  252.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  253.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  254.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  255.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  256.      & KINLFT,KOTLFT,KUNIT
  257.       E=2.7182818284
  258.       DX=FLOAT(IX-KMINSX)/TRFACX
  259.       DY=FLOAT(IY-KMINSY)/TRFACY
  260.       KEY=KEYCON
  261.       IF(KEYCON .LT. 1)KEY=5
  262.       IF(KEYCON .GT. 4)KEY=4
  263. C *       LINEAR LOG POLAR USER ERROR
  264.       GO TO(300, 400, 500, 600, 100  ),KEY
  265. C * ERROR
  266. 100   X=IX
  267.       Y=IY
  268.       GO TO 700
  269. C * LINEAR
  270. 300   X=DX+TMINVX
  271.       Y=DY+TMINVY
  272.       GO TO 700
  273. C * LOG SCALES
  274. 400   KEYL=TRPAR1
  275.       X=DX+TMINVX
  276.       Y=DY+TMINVY
  277.       IF(KEYL .EQ. 1 .OR. KEYL .EQ. 3)X=E**(DX+TRPAR2)
  278.       IF(KEYL .EQ. 2 .OR. KEYL .EQ. 3)Y=E**(DY+TRPAR3)
  279.       GO TO 700
  280. C * POLAR
  281. 500   DX=FLOAT(IX)-TRPAR3
  282.       DY=FLOAT(IY)-TRPAR4
  283.       Y=ATAN2(DY,DX)*57.2957795131
  284.       X=SQRT(DY*DY+DX*DX)/TRFACX+TRPAR5
  285. C * ADJUST ANGLE MOD 2 PI TO VALUE WITHIN WINDOW
  286.       DEC=.FALSE.
  287. 510   IF(Y .GT. TRPAR1) GO TO 530
  288. C * INCREMENT ANGLE
  289.       Y=Y+360.0
  290.       GO TO 510
  291. 530   IF(Y .LE. TRPAR2) GO TO 550
  292. C * DECREMENT ANGLE
  293.       Y=Y-360.0
  294.       DEC=.TRUE.
  295.       GO TO 530
  296. 550   IF(DEC .AND. Y .LT. TRPAR1)Y=Y+360.0
  297.       IF(TMINVX .GE. 0.)GO TO 560
  298.       TR1A=AMOD(TRPAR1+180.,360.)
  299.       TR2A=AMOD(TRPAR2+180.,360.)
  300.       IF(Y.GT.AMAX1(TR1A,TR2A).OR.Y.LT.AMIN1(TR1A,TR2A))GO TO 560
  301.       Y=AMOD(Y+180.,360.)
  302.       X=-X
  303. 560   Y=Y/TRFACY+TRPAR6
  304.       GO TO 700
  305. C * USER CONVERSION
  306. 600   CONTINUE
  307. C      CALL UREVCT(IX,IY,X,Y)
  308. C * EXIT POINT
  309. 700   CALL PCLIPT(X,Y)
  310.       RETURN
  311.       END
  312. c
  313.  
  314. C
  315. C----------SUBROUTINE--PSCAL-------------------------TEKTRONIX, INC.----
  316. C
  317.       SUBROUTINE PSCAL
  318.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  319.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  320.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  321.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  322.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  323.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  324.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  325.      & KINLFT,KOTLFT,KUNIT
  326.       LOGICAL ANEG
  327.       ANEG=TRPAR1 .GT. TRPAR2
  328. C * FLAG THE OLD VIRTUAL COORDINATES AS INCORRECT
  329.       KGRAFL=0
  330.       PIDV2=90.00
  331. C * SET UP UNTRANSLATED TRIAL POLAR WINDOW
  332.       TRPAR3=0.
  333.       TRPAR4=0.
  334.       TRFACY=1.
  335.       TRPAR6=0.
  336.       R1=TMINVX
  337.       R2=TMAXVX
  338.       RMAX=AMAX1(ABS(R1),ABS(R2))
  339.       TRFACX=1000./RMAX
  340.       THMIN=AMIN1(TRPAR1,TRPAR2)
  341.       THMAX=AMAX1(TRPAR2,TRPAR1)
  342. C * FIND EXTREMES OF THE TRIAL POLAR WINDOW
  343.       CALL WINCOT(R1,THMIN,IX1,IY1)
  344.       CALL WINCOT(R1,THMAX,IX2,IY2)
  345.       CALL WINCOT(R2,THMIN,IX3,IY3)
  346.       CALL WINCOT(R2,THMAX,IX4,IY4)
  347.       IXMIN=MIN0(IX1,IX2,IX3,IX4)
  348.       IXMAX=MAX0(IX1,IX2,IX3,IX4)
  349.       IYMIN=MIN0(IY1,IY2,IY3,IY4)
  350.       IYMAX=MAX0(IY1,IY2,IY3,IY4)
  351.       X=THMIN/PIDV2
  352.       IF(THMIN.GT.0.)X=X+.999
  353.       QUAD=FLOAT(IFIX(X))*PIDV2
  354.       NQUAD=0
  355. C * CHECK EXTREMES OF TRIAL WINDOW AT 90 DEGREE INTERVALS
  356. 200   IF(QUAD.GE.THMAX)GO TO 300
  357.       NQUAD=NQUAD+1
  358.       CALL WINCOT(R1,QUAD,IX1,IY1)
  359.       CALL WINCOT(R2,QUAD,IX2,IY2)
  360.       IXMIN=MIN0(IX1,IX2,IXMIN)
  361.       IXMAX=MAX0(IX1,IX2,IXMAX)
  362.       IYMIN=MIN0(IY1,IY2,IYMIN)
  363.       IYMAX=MAX0(IY1,IY2,IYMAX)
  364.       QUAD=QUAD+PIDV2
  365.       IF(NQUAD.LT.4)GO TO 200
  366. C * COMPUTE SCREEN AND VIRTUAL RANGES
  367. 300   TSRANX=KMAXSX-KMINSX
  368.       TSRANY=KMAXSY-KMINSY
  369.       XRANGE=IXMAX-IXMIN
  370.       YRANGE=IYMAX-IYMIN
  371. C * COMPUTE RELATIVE RADIUS SCALE FACTOR
  372.       FACTOR=AMIN1(ABS(TSRANX)/XRANGE,ABS(TSRANY)/YRANGE)
  373. C * COMPUTE SCREEN OFFSETS
  374.       TRPAR3=FLOAT(KMINSX)-FACTOR*FLOAT(IXMIN)
  375.       TRPAR4=FLOAT(KMINSY)-FACTOR*FLOAT(IYMIN)
  376. C * COMPUTE FINAL RADIUS SCALE FACTOR
  377.       TRFACX=TRFACX*FACTOR
  378. C * COMPUTE ANGLE SCALE FACTOR
  379.       TRFACY=(TRPAR2-TRPAR1)/(TMAXVY-TMINVY)
  380. C * APPLY CORRECT SIGN TO ANGLE SCALE FACTOR
  381.       TRFACY=SIGN(1.,TSRANX*TSRANY)*TRFACY
  382.       AANG=0.
  383. C * APPLY CORRECTION FOR 'REVERSED' WINDOWS
  384.       IF(ANEG.AND.TSRANY.LT.0..OR.TSRANX.LT.0..AND..NOT.ANEG)AANG=180.
  385. C * COMPUTE ANGLE OFFSET
  386.       TRPAR6=TMINVY-(TRPAR1+AANG)/TRFACY
  387.       RETURN
  388.       END
  389. c
  390. C
  391. C----------SUBROUTINE--WINCOT------------------------TEKTRONIX, INC.----
  392. C
  393.       SUBROUTINE WINCOT(X,Y,IX,IY)
  394.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  395.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  396.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  397.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  398.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  399.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  400.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  401.      & KINLFT,KOTLFT,KUNIT
  402.       DATA DE2RAD/0.01745/
  403. C * CHECK FOR PERMITTED VALUE OF CONVERSION KEY
  404. C * DEFAULT IS LINEAR,ERROR IS NONE
  405.       DX=X-TMINVX
  406.       DY=Y-TMINVY
  407.       KEY=KEYCON
  408.       IF(KEYCON .LT. 1)KEY=5
  409.       IF(KEYCON .GT. 4)KEY=4
  410. C * BRANCH TO PROPER SECTION
  411. C * LINEAR LOG POLAR USER ERROR
  412.       GO TO(500,300,600,700,100),KEY
  413. C       ERROR
  414. 100   IX=X
  415.       IY=Y
  416.       GO TO 800
  417. C * LOG TRANSFORM
  418. 300   KEYL=TRPAR1+.001
  419.       IF(KEYL .EQ. 2) GO TO 400
  420. C * SETUP X LOG TRANSFORM
  421.       DX=ALOG(X)-TRPAR2
  422. 400   IF(KEYL .EQ. 1) GO TO 500
  423. C * SETUP Y LOG TRANSFORM
  424.       DY=ALOG(Y)-TRPAR3
  425. C * CONVERT LINEAR
  426. 500   IX=IFIX(DX*TRFACX+.5)+KMINSX
  427.       IY=IFIX(DY*TRFACY+.5)+KMINSY
  428. C * GO TO EXIT
  429.       GO TO 800
  430. C * POLAR TRANSFORMATION
  431. 600   A=(Y-TRPAR6)*TRFACY
  432.       R=(X-TRPAR5)*TRFACX
  433.       IX=R*COS(A*DE2RAD)+TRPAR3
  434.       IY=R*SIN(A*DE2RAD)+TRPAR4
  435. C * GO TO EXIT
  436.       GO TO 800
  437. C * USER TRANSFORMATION IN USE
  438. 700   CONTINUE
  439. C      CALL USECOT(X,Y,IX,IY)
  440. C * EXIT POINT
  441. 800   RETURN
  442.       END
  443. C
  444. C----------SUBROUTINE--RESET-------------------------TEKTRONIX, INC.----
  445. C
  446.       SUBROUTINE RESET
  447.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  448.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  449.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  450.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  451.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  452.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  453.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  454.      & KINLFT,KOTLFT,KUNIT
  455.       KEYCON=1
  456.       TRFACX=1.
  457.       TRFACY=1.
  458.       KBEAMX=0
  459.       KHOMEY=3068/KFACTR
  460.       KBEAMY=KHOMEY
  461.       KMINSX=0
  462.       KMAXSX=4095/KFACTR
  463.       KMINSY=0
  464.       KMAXSY=3120/KFACTR
  465.       KHORSZ=56
  466.       KLINE=0
  467.       KZAXIS=0
  468.       KLMRGN=0
  469.       KRMRGN=4096/KFACTR
  470.       KSIZEF=1
  471.       KTBLSZ=10
  472.       KVERSZ=88
  473.       TMINVX=0.
  474.       TMAXVX=KMAXSX
  475.       TMINVY=0.
  476.       TMAXVY=KMAXSY
  477.       TRCOSF=1.
  478.       TRSINF=0.
  479.       TRSCAL=1.
  480. C * MOVE TO THE HOME POSITION
  481.       CALL MOVABS(KLMRGN,KHOMEY)
  482. C * SET 4014 ENHANCED FOR SOLID LINES
  483.       IF(KTERM .GE. 3)CALL CWSEND
  484. C * PLACE 4014 IN LARGE CHARACTER SIZE
  485.       IF(KTERM .GE. 2)CALL CHRSIZ(1)
  486. C * PLACE THE TERMINAL IN A/N MODE
  487.       CALL ALFMOD
  488.       RETURN
  489.       END
  490. c
  491. C
  492. C----------SUBROUTINE--CWSEND------------------------TEKTRONIX, INC.----
  493. C
  494.       SUBROUTINE CWSEND
  495.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  496.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  497.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  498.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  499.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  500.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  501.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  502.      & KINLFT,KOTLFT,KUNIT
  503.       DIMENSION ICODE(2)
  504.       DATA ICODE(1)/27/
  505.       ICODE(2)=96+KZAXIS*8+KLINE
  506.       CALL TOUTST(2,ICODE)
  507.       RETURN
  508.       END
  509. c
  510. C
  511. C----------SUBROUTINE--CHRSIZ------------------------TEKTRONIX, INC.----
  512. C
  513.       SUBROUTINE CHRSIZ(K)
  514.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  515.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  516.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  517.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  518.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  519.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  520.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  521.      & KINLFT,KOTLFT,KUNIT
  522.       DIMENSION ICODE(2),ICHRTB(2,4)
  523.       DATA ICHRTB(1,1),ICHRTB(2,1)/56,88/
  524.       DATA ICHRTB(1,2),ICHRTB(2,2)/51,82/
  525.       DATA ICHRTB(1,3),ICHRTB(2,3)/34,53/
  526.       DATA ICHRTB(1,4),ICHRTB(2,4)/31,48/
  527.       DATA ICODE(1)/27/
  528. C * CHECK TERMINAL TYPE
  529.       IF(KTERM .LE. 1)GO TO 10
  530.       KSIZEF=K
  531.       IF(K .LT. 1)KSIZEF=1
  532.       IF(K .GT. 4)KSIZEF=4
  533.       KHORSZ=ICHRTB(1,KSIZEF)
  534.       KVERSZ=ICHRTB(2,KSIZEF)
  535.       ICODE(2)=55+KSIZEF
  536.       CALL TOUTST(2,ICODE)
  537. 10    RETURN
  538.       END
  539. c
  540. C
  541. C----------SUBROUTINE--ALFMOD------------------------TEKTRONIX, INC.----
  542. C
  543.       SUBROUTINE ALFMOD
  544.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  545.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  546.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  547.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  548.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  549.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  550.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  551.      & KINLFT,KOTLFT,KUNIT
  552. C * SET ALPHA MODE OUTPUT (US)
  553.       CALL TOUTPT(31)
  554.       KGRAFL=0
  555.       KKMODE=0
  556.       IF(KBEAMY.GT.KHOMEY) KBEAMY=KHOMEY
  557.       RETURN
  558.       END
  559. c
  560. C
  561. C----------SUBROUTINE--NEWPAG------------------------TEKTRONIX, INC.----
  562. C
  563.       SUBROUTINE NEWPAG
  564.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  565.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  566.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  567.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  568.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  569.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  570.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  571.      & KINLFT,KOTLFT,KUNIT
  572.       DIMENSION ICODE(2)
  573.       DATA ICODE(1),ICODE(2)/27,12/
  574.       IF(KKMODE .NE. 0)CALL ALFMOD
  575. C * OUTPUT (ESC) (FF) FOR NEW PAGE
  576.       CALL TOUTST(2,ICODE)
  577.       CALL IOWAIT(10)
  578.       IF(KLMRGN.EQ.0)GO TO 10
  579.       CALL MOVABS(KLMRGN,KHOMEY)
  580.       CALL ALFMOD
  581.       GO TO 20
  582. 10    KBEAMX=0
  583.       KBEAMY=KHOMEY
  584. 20    RETURN
  585.       END
  586. c
  587. C
  588. C----------SUBROUTINE--TOUTST------------------------TEKTRONIX, INC.----
  589. C
  590.       SUBROUTINE TOUTST(LEN,IADE)
  591.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  592.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  593.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  594.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  595.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  596.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  597.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  598.      & KINLFT,KOTLFT,KUNIT
  599.       DIMENSION IADE(1)
  600.       LENOUT=LEN
  601.       IF(LENOUT .GT. KACHAR)LENOUT=KACHAR
  602.       CALL BUFFPK(LENOUT,IADE)
  603.       RETURN
  604.       END
  605. c
  606. C
  607. C----------SUBROUTINE--TINSTR------------------------TEKTRONIX, INC.----
  608. C
  609.       SUBROUTINE TINSTR(NCHAR,IADE)
  610.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  611.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  612.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  613.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  614.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  615.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  616.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  617.      & KINLFT,KOTLFT,KUNIT
  618.       DIMENSION INBUFF(80),IADE(1)
  619.       DATA ISENT,IGOT,IPAD/0,0,32/
  620.       IF(KINLFT .GT. 0)GO TO 10
  621. C * REQUEST A NEW INPUT BUFFER
  622. C * PUT OUT THE OUTPUT BUFFER
  623.       CALL TSEND
  624.       CALL ADEIN(IGOT,INBUFF)
  625.       IF(KTERM.GE.3) CALL CWSEND
  626.       ISENT=0
  627.       KINLFT=IGOT
  628. 10    LEN=NCHAR
  629.       IF(LEN .LE. 0)GO TO 50
  630.       DO 20 I=1,LEN
  631.       ISENT=ISENT+1
  632.       ITMP=I
  633.       IF(ISENT .GT. IGOT)GO TO 30
  634. 20    IADE(I)=INBUFF(ISENT)
  635.       KINLFT=IGOT-ISENT
  636.       GO TO 50
  637. C * PAD WITH BLANKS WHEN NEEDED
  638. 30    DO 40 I=ITMP,LEN
  639. 40    IADE(I)=IPAD
  640.       KINLFT=0
  641. 50    RETURN
  642.       END
  643. c
  644. C
  645. C----------SUBROUTINE--IOWAIT------------------------TEKTRONIX, INC.----
  646. C
  647.       SUBROUTINE IOWAIT(ITIME)
  648. C * THIS ROUTINE IS USED TO GENERATE DELAYS FOR REMOTE TERMINALS
  649.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  650.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  651.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  652.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  653.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  654.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  655.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  656.      & KINLFT,KOTLFT,KUNIT
  657.       IF(KBAUDR.LE.0)GO TO 20
  658.       KOUNT=ITIME*(KBAUDR/10)
  659.       DO 10 J=1,KOUNT
  660. C * OUTPUT (SYN) TO INSURE AGAINST LOSS OF OUTPUT WHILE
  661. C * TERMINAL IS BUSY. (SYN) DOES NOT AFFECT THE TERMINAL.
  662. 10    CALL TOUTPT(22)
  663. 20    RETURN
  664.       END
  665. c
  666. C
  667. C----------SUBROUTINE--VECMOD------------------------TEKTRONIX, INC.----
  668. C
  669.       SUBROUTINE VECMOD
  670.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  671.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  672.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  673.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  674.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  675.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  676.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  677.      & KINLFT,KOTLFT,KUNIT
  678.       IF(KKMODE.EQ.1)GO TO 10
  679. C * OUTPUT (US) TO ENTER A/N MODE AND RESET FOR VECTOR MODE
  680.       CALL TOUTPT(31)
  681.       DO 112 II=1,5
  682. 112   KPCHAR(II)=-1
  683.       KKMODE=1
  684. C * OUTPUT (GS) TO ENTER VECTOR MODE
  685. 10    CALL TOUTPT(29)
  686.       KMOVEF=1
  687.       RETURN
  688.       END
  689. c
  690. C
  691. C----------SUBROUTINE--XYCNVT------------------------TEKTRONIX, INC.----
  692. C
  693.       SUBROUTINE XYCNVT(IX,IY)
  694.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  695.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  696.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  697.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  698.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  699.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  700.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  701.      & KINLFT,KOTLFT,KUNIT
  702.       DIMENSION IPLT(5),IOPT(8)
  703.       DATA IDREW /0/
  704. C * RECEIVE THE PLOT CHARACTERS
  705.       IX1=MIN0(4095/KFACTR,MAX0(0,IX))
  706.       IY1=MIN0(4095/KFACTR,MAX0(0,IY))
  707.       CALL PLTCHR(IX1,IY1,IPLT)
  708. C * OPTIMIZE THE OUTPUT
  709.       LEN=0
  710. C * CHECK IF HIGH Y IS NEEDED
  711.       IF(KPCHAR(1) .EQ. IPLT(1))GO TO 10
  712. C * INCLUDE HIGH Y IF NEEDED
  713.       LEN=1
  714.       KPCHAR(1)=IPLT(1)
  715.       IOPT(1)=IPLT(1)
  716. C * CHECK IF LSBYX IS NEEDED
  717. 10    IF(KTERM .LE. 2)GO TO 20
  718.       IF(KPCHAR(2) .EQ. IPLT(2))GO TO 20
  719. C * INCLUDE LSBYX IF NEEDED
  720.       LEN=LEN+1
  721.       KPCHAR(2)=IPLT(2)
  722.       IOPT(LEN)=IPLT(2)
  723.       GO TO 30
  724. C * CHECK IF LOW Y IS NEEDED
  725. 20    IF(KPCHAR(3) .NE. IPLT(3))GO TO 30
  726.       IF(KPCHAR(4) .EQ. IPLT(4))GO TO 40
  727. C * INCLUDE LOW Y IF NEEDED
  728. 30    LEN=LEN+1
  729.       KPCHAR(3)=IPLT(3)
  730.       IOPT(LEN)=IPLT(3)
  731. C * CHECK IF HIGH X IS NEEDED
  732.       IF(KPCHAR(4) .EQ. IPLT(4))GO TO 50
  733. C * INCLUDE HIGH X IF NEEDED
  734.       LEN=LEN+1
  735.       KPCHAR(4)=IPLT(4)
  736.       IOPT(LEN)=IPLT(4)
  737. C * CHECK IF LOW X IS NEEDED
  738. 40    IF(KPCHAR(5) .NE. IPLT(5))GO TO 50
  739. C * CHECK IF ALL THE CHARACTERS ARE THE SAME
  740.       IF(LEN .NE. 0)GO TO 50
  741. C * CHECK IF (GS) FOR DARK VECTOR ALREADY SENT
  742.       IF(KMOVEF .EQ. 1)GO TO 50
  743. C * CHECK IF VECTOR IS ALREADY DRAWN TO SPOT
  744.       IF(IDREW .EQ. 1)GO TO 80
  745. C * INCLUDE THE LOW X
  746. 50    LEN=LEN+1
  747.       KPCHAR(5)=IPLT(5)
  748.       IOPT(LEN)=IPLT(5)
  749. C * SEND THE ARRAY TO THE OUTPUT BUFFER
  750. 70    CALL TOUTST(LEN,IOPT)
  751. C * SET THE COMMON AND HISTORY VARIABLES
  752. C * SET THE DREW HERE FLAG
  753.       IDREW=1
  754. C * REMOVE  THE DREW HERE FLAG IF DIDNT DRAW
  755.       IF(KMOVEF .EQ. 1)IDREW=0
  756. C * REMOVE THE MOVE FLAG
  757.       KMOVEF=0
  758. 80    KBEAMX=IX1
  759.       KBEAMY=IY1
  760.       RETURN
  761.       END
  762. c
  763. C
  764. C----------SUBROUTINE--TOUTPT------------------------TEKTRONIX, INC.----
  765. C
  766.       SUBROUTINE TOUTPT(KKOUT)
  767.       DIMENSION KOUT(1)
  768.       KOUT(1)=KKOUT
  769.       CALL TOUTST(1,KOUT)
  770.       RETURN
  771.       END
  772. c
  773. C
  774. C----------SUBROUTINE--PLTCHR------------------------TEKTRONIX, INC.----
  775. C
  776.       SUBROUTINE PLTCHR(IX,IY,ICHAR)
  777.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  778.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  779.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  780.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  781.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  782.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  783.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  784.      & KINLFT,KOTLFT,KUNIT
  785.       DIMENSION ICHAR(5)
  786. C * CALCULATE THE PLOT CHARACTERS TO ARRIVE AT IX,IY
  787. C * ORDER IS HIY, LSBYX, LOY, HIX, LOX
  788.       KX=IX*KFACTR
  789.       KY=IY*KFACTR
  790.       ICHAR(1)=MOD(KY/128,32)+32
  791.       ICHAR(2)=MOD(KY,4)*4+MOD(KX,4)+96
  792.       ICHAR(3)=MOD(KY/4,32)+96
  793.       ICHAR(4)=MOD(KX/128,32)+32
  794.       ICHAR(5)=MOD(KX/4,32)+64
  795.       IF(KBAUDR .LT. 480) GO TO 11
  796.       ITEMP=KPAD2-1
  797.       IF(KTERM .LT. 2) GO TO 10
  798.       ITEMP=IABS(KBEAMX-IX)+IABS(KBEAMY-IY)
  799.       ITEMP=ITEMP*KPAD2*KFACTR/8192 + 1
  800. 10    KPADV=ITEMP
  801. 11    CONTINUE
  802.       RETURN
  803.       END
  804. c
  805. C
  806. C----------SUBROUTINE--BUFFPK------------------------TEKTRONIX, INC.----
  807. C
  808.       SUBROUTINE BUFFPK(NCHAR,IOUT)
  809.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  810.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  811.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  812.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  813.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  814.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  815.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  816.      & KINLFT,KOTLFT,KUNIT
  817.       DIMENSION IDATA(80),IOUT(1),ISYNC(5)
  818.       DATA MAXLEN,LENOUT,NODATA/80,0,1/
  819.       DATA ITEMP/0/,ISYNC(1),ISYNC(2),ISYNC(3),ISYNC(4),ISYNC(5)/5*22/
  820.       ITRAIL=KTRAIL
  821.       LEN=NCHAR
  822.       KOTLFT=MAXLEN-LENOUT-KTRAIL
  823. C * DUMP THE BUFFER IF THE MODE IS UNBUFFERED
  824.       IF(KUNIT .EQ. 4)GO TO 45
  825. C * DUMP THE BUFFER WHEN REQUESTED BY LEN=0
  826.       IF(NCHAR .LE. 0)GO TO 10
  827. C * DON'T DUMP THE BUFFER IF NEW STRING WILL FIT
  828.       KSYNCS=KPADV
  829.       ISETBK=0
  830.       NCH=NCHAR-1
  831.       IF(IOUT(1) .GT. 31) ISETBK=MIN0(ITEMP,NCH)
  832.       IMAXL=KSYNCS+NCHAR-ISETBK
  833.       IF(IMAXL .LE. KOTLFT)GO TO 70
  834. C * DETERMINE IF THERE IS DATA IN BUFFER
  835. 10    IF(NODATA .EQ. 1)GO TO 50
  836.       NODATA=1
  837. C * DETERMINE THE FORMAT THE USER WANTS BUFFER DUMPED IN
  838.       GO TO (20,30,40,45),KUNIT
  839. C * OUTPUT BUFFER FORMAT IS (GS),PLTCHRS,DATA,(US)
  840. 20    LENOUT=LENOUT+1
  841. C * APPEND (US) TO END OF BUFFER
  842.       IDATA(LENOUT)=31
  843.       CALL ADEOUT(LENOUT,IDATA)
  844. C * RESTORE THE BEAM POSITION AT FIRST OF THE NEXT BUFFER
  845.       ISUB=1
  846.       IF(KTERM .GE. 3) ISUB=2
  847.       CALL PLTCHR(KBEAMX,KBEAMY,IDATA(ISUB))
  848.       IDATA(2)=IDATA(ISUB)
  849.       LENOUT=5+ISUB
  850.       IDATA(1)=29
  851. C * AND NOW THE MODE BEFORE THE OUTPUT WAS ASKED FOR
  852.       DO 19 I=2,KPAD2
  853.       IDATA(LENOUT)=22
  854. 19    LENOUT=LENOUT+1
  855.       KEY=KKMODE+1
  856.       IF(KEY .LT. 1)KEY=1
  857.       IF(KEY .GT. 5)KEY=1
  858. C * MODE IS A/N,VEC,PNT,INC,DSH
  859.       GO TO (21, 22, 23, 24, 22),KEY
  860. C * ENTER A/N MODE
  861. 21    IDATA(LENOUT)=31
  862.       GO TO 50
  863. C * IF READY FOR A MOVE, THEN REMOVE FIXUP CHARS
  864. 22    IF(KMOVEF .EQ. 1) LENOUT=2
  865.       LENOUT=LENOUT-1
  866. C * CHECK IF DASHED LINE OR Z AXIS MUST BE RESTORED
  867.       IF(KLINE .EQ. 0 .AND. KZAXIS .EQ. 0) GO TO 50
  868.       IDATA(LENOUT+1)=27
  869.       LENOUT=LENOUT+2
  870.       IDATA(LENOUT)=96+KZAXIS*8+KLINE
  871.       GO TO 50
  872. C * ENTER POINT MODE
  873. 23    IF(KTERM .LT. 3)GO TO 22
  874.       IDATA(LENOUT)=28
  875.       LENOUT=LENOUT+1
  876.       GO TO 22
  877. C * ENTER INCREMENTAL PLOT MODE
  878. 24    IDATA(LENOUT)=30
  879. C * RAISE OR LOWER PEN AS NEEDED
  880. C * THE FOLLOWING 3 LINES ARE NOT NEEDED ON SOME PLOTTERS **************
  881.       LENOUT=LENOUT+1
  882.       IDATA(LENOUT)=80
  883.       IF(KMOVEF .EQ. 1)IDATA(LENOUT)=32
  884. C **********************************************************************
  885.       GO TO 50
  886. C * OUTPUT BUFFER FORMAT IS (SYN),DATA,(ESC)
  887. 30    IF(NCHAR .LE. 0 .AND. KGNMOD .NE. 1)GO TO 20
  888.       LENOUT=LENOUT+1
  889. C * APPEND (ESC) TO END OF BUFFER
  890.       IDATA(LENOUT)=27
  891.       CALL ADEOUT(LENOUT,IDATA)
  892.       IDATA(1)=22
  893.       LENOUT=1
  894.       GO TO 50
  895. C * OUTPUT BUFFER FORMAT IS DATA ONLY
  896. 40    CALL ADEOUT(LENOUT,IDATA)
  897.       LENOUT=0
  898.       GO TO 50
  899. C * NON-BUFFERED OUTPUT FORMAT
  900. 45    IF(LENOUT .GT. 0)CALL ADEOUT(LENOUT,IDATA)
  901.       IF(LEN .GT. 0)CALL ADEOUT(LEN,IOUT)
  902.       IF(KPADV .GT. 0)CALL ADEOUT(KPADV,ISYNC)
  903.       KPADV=0
  904.       LENOUT=0
  905.       NODATA=1
  906.       GO TO 90
  907. 50    KOTLFT=MAXLEN-LENOUT-ITRAIL
  908.       ITEMP=0
  909.       ISETBK=0
  910.       KPADV=0
  911.       IF(LEN .LE. 0) GO TO 90
  912. 70    NODATA=0
  913.       LENOUT=LENOUT-ISETBK
  914.       KOTLFT=KOTLFT+ISETBK
  915.       IF(LEN .GT. KOTLFT)LEN=KOTLFT
  916.       DO 80 I=1,LEN
  917.       LENOUT=LENOUT+1
  918. 80    IDATA(LENOUT)=IOUT(I)
  919.       ITEMP=KSYNCS
  920.       KPADV=0
  921.       IF(ITEMP .LE. 0) GO TO 90
  922.       DO 85 I=1,ITEMP
  923.       LENOUT=LENOUT+1
  924. 85    IDATA(LENOUT)=22
  925. 90    KOTLFT=MAXLEN-LENOUT-ITRAIL
  926.       RETURN
  927.       END
  928. c
  929. C
  930. C----------SUBROUTINE--RESCAL------------------------TEKTRONIX, INC.----
  931. C
  932.       SUBROUTINE RESCAL
  933.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  934.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  935.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  936.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  937.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  938.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  939.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  940.      & KINLFT,KOTLFT,KUNIT
  941. C * FLAG THE OLD VIRTUAL COORDINATES AS INCORRECT
  942.       KGRAFL=0
  943.       KGNFLG=0
  944.       KEY=KEYCON
  945.       IF(KEYCON .LT. 1)KEY=5
  946.       IF(KEYCON .GT. 4)KEY=4
  947. C * BRANCH TO PROPER SECTION AND RETURN
  948. C * LINEAR LOG POLAR USER ERROR
  949.       GO TO (100,200,300,400,500),KEY
  950. C * BOTH AXES LINEAR
  951. 100   TRPAR1=0.
  952. C * SEMI LOG OR LOG LOG
  953. 200   KEYL=TRPAR1+1.001
  954. C * X AXIS -- LINEAR OR LOG
  955.       GO TO (210,215,210,215),KEYL
  956. C * LINEAR
  957. 210   TRFACX=FLOAT(KMAXSX-KMINSX)/(TMAXVX-TMINVX)
  958.       GO TO 250
  959. C * PREVENT INVALID TRANSFORMATION
  960. 215   IF(TMINVX .GT. 0.0 .AND. TMAXVX .GT. 0.0)GO TO 220
  961.       KGNFLG=1
  962.       TRPAR1=TRPAR1-1.0
  963.       GO TO 210
  964. C * SEMI LOG X AXIS
  965. 220   TRPAR2=ALOG(TMINVX)
  966.       TRFACX=FLOAT(KMAXSX-KMINSX)/(ALOG(TMAXVX)-TRPAR2)
  967. C * Y AXIS -- LINEAR OR LOG
  968. 250   GO TO (260,260,270,270),KEYL
  969. C * LINEAR
  970. 260   TRFACY=FLOAT(KMAXSY-KMINSY)/(TMAXVY-TMINVY)
  971.       GO TO 600
  972. C * PREVENT INVALID TRANSFORMATION
  973. 270   IF(TMINVY .GT. 0.0 .AND. TMAXVY .GT. 0.0)GO TO 280
  974.       KGNFLG=1
  975.       TRPAR1=TRPAR1-2.0
  976.       GO TO 260
  977. C * SEMI LOG Y AXIS
  978. 280   TRPAR3=ALOG(TMINVY)
  979.       TRFACY=FLOAT(KMAXSY-KMINSY)/(ALOG(TMAXVY)-TRPAR3)
  980.       GO TO 600
  981. C * POLAR SCALING
  982. 300   CALL PSCAL
  983.       GO TO 600
  984. C * USER FUNCTION
  985. 400   CONTINUE
  986. C      CALL URSCAL
  987.       GO TO 600
  988. C * NO SCALE
  989. 500   TRFACX=1.
  990.       TRFACY=1.
  991. 600   RETURN
  992.       END
  993. c
  994. C
  995. C----------SUBROUTINE--LVLCHT------------------------TEKTRONIX, INC.----
  996. C
  997.       SUBROUTINE LVLCHT
  998.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  999.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  1000.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  1001.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  1002.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  1003.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  1004.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  1005.      & KINLFT,KOTLFT,KUNIT
  1006.       IF(KGRAFL.NE.0)GO TO 10
  1007.       CALL REVCOT(KBEAMX,KBEAMY,TREALX,TREALY)
  1008.       TIMAGX=TREALX
  1009.       TIMAGY=TREALY
  1010.       KGRAFL=1
  1011. 10    RETURN
  1012.       END
  1013. c
  1014. C
  1015. C----------SUBROUTINE--V2ST--------------------------TEKTRONIX, INC.----
  1016. C
  1017.       SUBROUTINE V2ST(I,X,Y,IX,IY)
  1018.       DIMENSION BUFIN(4),BFOUT(4)
  1019.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  1020.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  1021.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  1022.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  1023.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  1024.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  1025.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  1026.      & KINLFT,KOTLFT,KUNIT
  1027.       EQUIVALENCE (BUFIN(1),XS),(BUFIN(2),YS),(BUFIN(3),XE),
  1028.      1(BUFIN(4),YE)
  1029.       EQUIVALENCE (BFOUT(1),CXS),(BFOUT(2),CYS),(BFOUT(3),CXE),
  1030.      1            (BFOUT(4),CYE)
  1031.       XE=X
  1032.       YE=Y
  1033. C * POINT OR MOVE
  1034.       IF(I .EQ. 0) GO TO 10
  1035. C * BRIGHT VECTOR
  1036.       XS=TIMAGX
  1037.       YS=TIMAGY
  1038. C * CLIP VECTOR
  1039.       CALL CLIPT(BUFIN,BFOUT)
  1040. C * ON SCREEN
  1041.       IF(KGNFLG .EQ. 1) GO TO 110
  1042. C * ARE WE AT START POINT
  1043.       IF(CXS .EQ. TREALX .AND. CYS .EQ. TREALY) GO TO 120
  1044. C * MOVE BEAM TO START POINT
  1045.       MODE=KKMODE
  1046.       CALL VECMOD
  1047.       CALL WINCOT(CXS,CYS,IX,IY)
  1048.       CALL XYCNVT(IX,IY)
  1049.       KKMODE=MODE
  1050.       GO TO 120
  1051. C * POINT OR MOVE
  1052. 10    CALL PCLIPT(XE,YE)
  1053. C * OFF SCREEN
  1054.       IF(KGNFLG .EQ. 1) GO TO 110
  1055.       CXE=XE
  1056.       CYE=YE
  1057. C * CONVERT TO SCREEN COORDINATES
  1058. 120   CALL WINCOT(CXE,CYE,IX,IY)
  1059. C * SAVE POSITION  ABS AND IMAGINARY
  1060.       TREALX=CXE
  1061.       TREALY=CYE
  1062. 110   TIMAGX=X
  1063.       TIMAGY=Y
  1064.       RETURN
  1065.       END
  1066. c
  1067. C
  1068. C----------SUBROUTINE--PNTMOD------------------------TEKTRONIX, INC.----
  1069. C
  1070.       SUBROUTINE PNTMOD
  1071.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  1072.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  1073.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  1074.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  1075.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  1076.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  1077.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  1078.      & KINLFT,KOTLFT,KUNIT
  1079. C * CANCEL PREVIOUS MODES - OUTPUT (US)
  1080.       CALL TOUTPT(31)
  1081.       DO 111 II=1,5
  1082. 111   KPCHAR(II)=-1
  1083.       KKMODE=2
  1084. C * FOR HARDWARE POINT PLOT OUTPUT AN (FS)
  1085.       IF(KTERM .GE. 3)CALL TOUTPT(28)
  1086.       RETURN
  1087.       END
  1088. c
  1089. C
  1090. C----------SUBROUTINE--TKPNT-------------------------TEKTRONIX, INC.----
  1091. C
  1092.       SUBROUTINE TKPNT(IX,IY)
  1093.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  1094.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  1095.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  1096.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  1097.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  1098.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  1099.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  1100.      & KINLFT,KOTLFT,KUNIT
  1101. C * THIS SECTION IS FOR 4014 ENHANCED **********************************
  1102. C      IF(KTERM .GE. 3)GO TO 10
  1103. C **********************************************************************
  1104. C * PUT OUT A GS FOR SIMULATED POINT PLOT MODE
  1105.       CALL TOUTPT(29)
  1106.       KMOVEF=1
  1107. C * MOVE TO POINT
  1108.       CALL XYCNVT(IX,IY)
  1109. C * DRAW  POINT
  1110. 10    CALL XYCNVT(IX,IY)
  1111.       RETURN
  1112.       END
  1113. c
  1114. C
  1115. C----------SUBROUTINE--CLIPT-------------------------TEKTRONIX, INC.----
  1116. C
  1117.       SUBROUTINE CLIPT(BUFIN,OUTBF)
  1118.       DIMENSION  BUFIN(4),OUTBF(4)
  1119.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  1120.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  1121.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  1122.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  1123.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  1124.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  1125.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  1126.      & KINLFT,KOTLFT,KUNIT
  1127.       GSTAX=BUFIN(1)
  1128.       GSTAY=BUFIN(2)
  1129.       GENDX=BUFIN(3)
  1130.       GENDY=BUFIN(4)
  1131.       IF(GSTAX.GE.TMINVX)GO TO 10
  1132.       IF(GENDX.GE.TMINVX)GO TO 20
  1133.       GO TO 110
  1134. 10    IF(GSTAX.LE.TMAXVX)GO TO 20
  1135.       IF(GENDX.LE.TMAXVX)GO TO 20
  1136.       GO TO 110
  1137. 20    IF(GSTAY.GE.TMINVY)GO TO 21
  1138.       IF(GENDY.GE.TMINVY)GO TO 30
  1139.       GO TO 110
  1140. 21    IF(GSTAY.LE.TMAXVY)GO TO 30
  1141.       IF(GENDY.LE.TMAXVY)GO TO 30
  1142.       GO TO 110
  1143. 30    IF(GSTAX.NE.GENDX)GO TO 31
  1144.       DSTAX=GSTAX
  1145.       DENDX=GSTAX
  1146.       CALL PARCLT(GSTAY,GENDY,TMINVY,TMAXVY,DSTAY,DENDY)
  1147.       GO TO 120
  1148. 31    IF(GSTAY.NE.GENDY)GO TO 40
  1149.       DSTAY=GSTAY
  1150.       DENDY=GSTAY
  1151.       CALL PARCLT(GSTAX,GENDX,TMINVX,TMAXVX,DSTAX,DENDX)
  1152.       GO TO 120
  1153. 40    A=GENDX-GSTAX
  1154.       B=GENDY-GSTAY
  1155.       IF(GSTAX.LT.TMINVX)GO TO 41
  1156.       IF(GSTAX.LE.TMAXVX)GO TO 43
  1157.       Q=TMAXVX
  1158.       GO TO 42
  1159. 43    IF(GSTAY.GT.TMAXVY)GO TO 140
  1160.       IF(GSTAY.LT.TMINVY)GO TO 44
  1161.       DSTAX=GSTAX
  1162.       DSTAY=GSTAY
  1163.       GO TO 150
  1164. 41    Q=TMINVX
  1165. 42    DSTAY=GSTAY+((Q-GSTAX)*B/A)
  1166.       IF(DSTAY.GT.TMAXVY)GO TO 140
  1167.       IF(DSTAY.LT.TMINVY)GO TO 44
  1168.       DSTAX=Q
  1169.       GO TO 150
  1170. 44    R=TMINVY
  1171.       GO TO 45
  1172. 140   R=TMAXVY
  1173. 45    DSTAX=GSTAX+((R-GSTAY)*A/B)
  1174.       IF(DSTAX.GT.TMAXVX)GO TO 110
  1175.       IF(DSTAX.LT.TMINVX)GO TO 110
  1176.       DSTAY=R
  1177. 150   IF(GENDX.LT.TMINVX)GO TO 50
  1178.       IF(GENDX.GT.TMAXVX)GO TO 51
  1179.       IF(GENDY.GT.TMAXVY)GO TO 160
  1180.       IF(GENDY.LT.TMINVY)GO TO 52
  1181.       DENDX=GENDX
  1182.       DENDY=GENDY
  1183.       GO TO 120
  1184. 51    Q=TMAXVX
  1185.       GO TO 53
  1186. 50    Q=TMINVX
  1187. 53    DENDY=GSTAY+((Q-GSTAX)*B/A)
  1188.       IF(DENDY.GT.TMAXVY)GO TO 160
  1189.       IF(DENDY.LT.TMINVY)GO TO 52
  1190.       DENDX=Q
  1191.       GO TO 120
  1192. 52    R=TMINVY
  1193.       GO TO 60
  1194. 160   R=TMAXVY
  1195. 60    DENDX=GSTAX+((R-GSTAY)*A/B)
  1196.       DENDY=R
  1197. 120   OUTBF(1)=DSTAX
  1198.       OUTBF(2)=DSTAY
  1199.       OUTBF(3)=DENDX
  1200.       OUTBF(4)=DENDY
  1201.       KGNFLG=0
  1202.       GO TO 70
  1203. C * SET FLAG IF LINE OUTSIDE WINDOW
  1204. 110   KGNFLG=1
  1205. 70    RETURN
  1206.       END
  1207. c
  1208. C
  1209. C----------SUBROUTINE--PCLIPT------------------------TEKTRONIX, INC.----
  1210. C
  1211.       SUBROUTINE PCLIPT(X,Y)
  1212.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  1213.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  1214.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  1215.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  1216.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  1217.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  1218.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  1219.      & KINLFT,KOTLFT,KUNIT
  1220.       KGNFLG=0
  1221.       IF(X.LT.TMINVX)GO TO 10
  1222.       IF(X.GT.TMAXVX)GO TO 10
  1223.       IF(Y.LT.TMINVY)GO TO 10
  1224.       IF(Y.LE.TMAXVY)GO TO 20
  1225. 10    KGNFLG=1
  1226. 20    RETURN
  1227.       END
  1228. c
  1229. C
  1230. C----------SUBROUTINE--PARCLT------------------------TEKTRONIX, INC.----
  1231. C
  1232.       SUBROUTINE PARCLT(RL1,RL2,RM1,RM2,RN1,RN2)
  1233.       IF(RL1.LT.RM1)GO TO 10
  1234.       IF(RL1.GT.RM2)GO TO 20
  1235.       RN1=RL1
  1236.       IF(RL2-RM1)30,40,40
  1237. 10    RN1=RM1
  1238. 40    IF(RL2.LE.RM2)GO TO 50
  1239.       RN2=RM2
  1240.       GO TO 60
  1241. 50    RN2=RL2
  1242.       GO TO 60
  1243. 20    RN1=RM2
  1244.       IF(RL2.GE.RM1)GO TO 50
  1245. 30    RN2=RM1
  1246. 60    RETURN
  1247.       END
  1248. c
  1249. C
  1250. C----------SUBROUTINE--TSEND-------------------------TEKTRONIX, INC.----
  1251. C
  1252.       SUBROUTINE TSEND
  1253.       DIMENSION ITEMP(1)
  1254.       CALL BUFFPK(0,ITEMP)
  1255.       RETURN
  1256.       END
  1257. c
  1258. C
  1259. C----------SUBROUTINE--RECOVR------------------------TEKTRONIX, INC.----
  1260. C
  1261.       SUBROUTINE RECOVR
  1262.       COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY,
  1263.      & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY,
  1264.      & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2),
  1265.      & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2,
  1266.      & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ,
  1267.      & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY,
  1268.      & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON,
  1269.      & KINLFT,KOTLFT,KUNIT
  1270. C * SAVE THE GRAPHIC LEVEL FLAG
  1271.       IFLAG=KGRAFL
  1272. C * REMOVE MOVE FLAG
  1273.       KMOVEF=0
  1274. C * SAVE THE MODE
  1275.       MODE=KKMODE+1
  1276. C * SAVE THE Y-COORDINATE
  1277.       IY=KBEAMY
  1278. C * CLEAR ALL OTHER MODES
  1279.       CALL ALFMOD
  1280. C * MOVE TO SCREEN LOCATION
  1281.       CALL MOVABS(KBEAMX,IY)
  1282. C * SET THE HARDWARE DASH AND Z-AXIS WHEN NEEDED
  1283.       IF(KTERM .GE. 2)CALL CWSEND
  1284. C * PLACE IN THE PROPER MODE
  1285.       IF(MODE .LT. 1)MODE=1
  1286.       IF(MODE .GT.5)MODE=5
  1287.       GO TO (100,200,120,100,200),MODE
  1288. 100   CALL ALFMOD
  1289.       GO TO 200
  1290. 120   CALL PNTMOD
  1291. C * RESTORE THE GRAPHIC LEVEL FLAG
  1292. 200   KGRAFL=IFLAG
  1293.       RETURN
  1294.       END
  1295. c
  1296. C
  1297.       SUBROUTINE ADEIN(NCHAR,IARAY)
  1298.       DIMENSION IARAY(1),KARAY(72)
  1299. C
  1300. C     860527;rb
  1301. C     lab of phys chem
  1302. C
  1303.       READ 5, KARAY
  1304.     5 FORMAT(72A1)
  1305.       DO 10 K=1,72
  1306.         IF (KARAY(73-K).NE.' ') GO TO 20
  1307.    10    CONTINUE
  1308.       NCHAR=0
  1309.       RETURN
  1310.    20 NCHAR=73-K
  1311.       DO 30 I=1,NCHAR
  1312.         IARAY(I)=IAND(KARAY(I),127)
  1313.    30   CONTINUE
  1314.       RETURN
  1315.       END
  1316. C
  1317.       SUBROUTINE ADEOUT(NCHAR,IARAY)
  1318. C
  1319. C     860427;rb
  1320. C     lab of physical chemistry
  1321. C
  1322.       DIMENSION IARAY(1)
  1323.       BYTE      KARAY(80)
  1324. C
  1325. C     check for NCHAR = 0
  1326.       IF (NCHAR.EQ.0) RETURN
  1327. C     check for NCHAR > 80
  1328.       IF (NCHAR.GT.80) THEN
  1329.         PRINT *,(' TCS OVERFLOW'),NCHAR
  1330.         STOP
  1331.         ENDIF
  1332.       DO 50 I=1,NCHAR
  1333.       KARAY(I)=IAND(IARAY(I),127)
  1334.    50 CONTINUE
  1335.       CALL SEND (NCHAR,KARAY)
  1336.       RETURN
  1337.       END
  1338. C
  1339. c......... VAX/VMS specific
  1340. c
  1341.     SUBROUTINE SEND(NCHARS,ARRAY)
  1342. C
  1343. C       AJC 2/27/84
  1344. C    RB  12/23/87
  1345. C
  1346.     INCLUDE '($IODEF)'
  1347.     INCLUDE '($SSDEF)'
  1348.     INCLUDE '($TTDEF)'
  1349. C
  1350.     BYTE ARRAY(1)
  1351. C
  1352.     INTEGER*4 SYS$QIOW,ICHAN
  1353.     INTEGER*2 IOSB(4)
  1354. C
  1355.     COMMON /IOINFO/ ICHAN
  1356. C
  1357.     IFUNC = IO$_WRITEVBLK + IO$M_NOFORMAT
  1358. C
  1359.     IRETURN = SYS$QIOW(,%VAL(ICHAN),%VAL(IFUNC),,,,
  1360.     1    ARRAY,%VAL(NCHARS),,,,)
  1361. C
  1362.     IF (IRETURN.NE.1)  CALL ERRMSG(IRETURN)
  1363.     RETURN
  1364.     END
  1365. c
  1366.       SUBROUTINE CHANNEL
  1367.       INTEGER*4 SYS$ASSIGN,ICHAN
  1368.       COMMON /IOINFO/ ICHAN
  1369.       LOGICAL LFLAG
  1370.       DATA LFLAG/.TRUE./
  1371.       IF (LFLAG) THEN
  1372.         IRETURN = SYS$ASSIGN('TT:',ICHAN,,)
  1373.         LFLAG=.FALSE.
  1374.         ENDIF
  1375.       RETURN
  1376.       END
  1377. c
  1378.  
  1379.